# Initialize ----
source('src/initialize.R')

# Figure 1 ----
anno.df1 <-
  data.frame(
    x1 = rep(1, 8),
    x2 = rep(2, 8),
    y1 = c(52.9, 47.9, 77.9, 77.5, 56.7, 51.6, 43.3, 33.9), #ub on control
    y2 = NA,
    xstar = rep(1.5, 8),
    ystar = NA,
    est = c(
      mean(ds$therm[ds$t_te == 1 & ds$t_si == 0], na.rm = TRUE) -
        mean(ds$therm[ds$t_te == 0 & ds$t_si == 0], na.rm = TRUE),
      mean(ds$therm[ds$t_te == 1 & ds$t_si == 1], na.rm = TRUE) -
        mean(ds$therm[ds$t_te == 0 & ds$t_si == 1], na.rm = TRUE),
      mean(
        ds$therm[ds$t_te == 1 & ds$t_si == 0 & ds$pid == "rep"],
        na.rm = TRUE
      ) -
        mean(
          ds$therm[ds$t_te == 0 & ds$t_si == 0 & ds$pid == "rep"],
          na.rm = TRUE
        ),
      mean(
        ds$therm[ds$t_te == 1 & ds$t_si == 1 & ds$pid == "rep"],
        na.rm = TRUE
      ) -
        mean(
          ds$therm[ds$t_te == 0 & ds$t_si == 1 & ds$pid == "rep"],
          na.rm = TRUE
        ),
      mean(
        ds$therm[ds$t_te == 1 & ds$t_si == 0 & ds$pid == "ind"],
        na.rm = TRUE
      ) -
        mean(
          ds$therm[ds$t_te == 0 & ds$t_si == 0 & ds$pid == "ind"],
          na.rm = TRUE
        ),
      mean(
        ds$therm[ds$t_te == 1 & ds$t_si == 1 & ds$pid == "ind"],
        na.rm = TRUE
      ) -
        mean(
          ds$therm[ds$t_te == 0 & ds$t_si == 1 & ds$pid == "ind"],
          na.rm = TRUE
        ),
      mean(
        ds$therm[ds$t_te == 1 & ds$t_si == 0 & ds$pid == "dem"],
        na.rm = TRUE
      ) -
        mean(
          ds$therm[ds$t_te == 0 & ds$t_si == 0 & ds$pid == "dem"],
          na.rm = TRUE
        ),
      mean(
        ds$therm[ds$t_te == 1 & ds$t_si == 1 & ds$pid == "dem"],
        na.rm = TRUE
      ) -
        mean(
          ds$therm[ds$t_te == 0 & ds$t_si == 1 & ds$pid == "dem"],
          na.rm = TRUE
        )
    ),
    p = c(
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 0],
        ds$therm[ds$t_te == 0 & ds$t_si == 0]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 1],
        ds$therm[ds$t_te == 0 & ds$t_si == 1]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 0 & ds$pid == "rep"],
        ds$therm[ds$t_te == 0 & ds$t_si == 0 & ds$pid == "rep"]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 1 & ds$pid == "rep"],
        ds$therm[ds$t_te == 0 & ds$t_si == 1 & ds$pid == "rep"]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 0 & ds$pid == "ind"],
        ds$therm[ds$t_te == 0 & ds$t_si == 0 & ds$pid == "ind"]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 1 & ds$pid == "ind"],
        ds$therm[ds$t_te == 0 & ds$t_si == 1 & ds$pid == "ind"]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 0 & ds$pid == "dem"],
        ds$therm[ds$t_te == 0 & ds$t_si == 0 & ds$pid == "dem"]
      )$p.value,
      t.test(
        ds$therm[ds$t_te == 1 & ds$t_si == 1 & ds$pid == "dem"],
        ds$therm[ds$t_te == 0 & ds$t_si == 1 & ds$pid == "dem"]
      )$p.value
    ),
    cand_ideo = rep(
      c('Moderately\nConservative', 'Extremely\nConservative'),
      4
    ),
    pid = c(
      '1.1 Full Sample',
      '1.1 Full Sample',
      '1.2 Republican Sample',
      '1.2 Republican Sample',
      '1.3 Independent Sample',
      '1.3 Independent Sample',
      '1.4 Democratic Sample',
      '1.4 Democratic Sample'
    )
  ) %>%
  mutate(
    y1 = y1 + 3,
    y2 = y1 + 3,
    ystar = y2 + 3,
    lab = paste0("p = ", format(round(p, 2), nsmall = 2)),
    lab = ifelse(p < 0.01, "p < 0.01", lab),
    pid = factor(
      pid,
      levels = c(
        '1.1 Full Sample',
        '1.2 Republican Sample',
        '1.3 Independent Sample',
        '1.4 Democratic Sample'
      ),
      labels = c(
        '1.1 Full Sample',
        '1.2 Republican Sample',
        '1.3 Independent Sample',
        '1.4 Democratic Sample'
      )
    ),
    cand_ideo = factor(
      cand_ideo,
      levels = c('Moderately\nConservative', 'Extremely\nConservative'),
      labels = c('Moderately\nConservative', 'Extremely\nConservative')
    )
  )

ds %>%
  filter(!is.na(therm), !is.na(treatment), !is.na(pid)) %>%
  group_by(treatment, pid) %>%
  summarise(
    mean = mean(therm),
    se = sd(therm) / sqrt(length(therm)),
    lb = mean - 1.96 * se,
    ub = mean + 1.96 * se
  ) %>%
  bind_rows(
    ds %>%
      filter(!is.na(therm), !is.na(treatment)) %>%
      group_by(treatment) %>%
      summarise(
        pid = as.factor('avg'),
        mean = mean(therm),
        se = sd(therm) / sqrt(length(therm)),
        lb = mean - 1.96 * se,
        ub = mean + 1.96 * se
      )
  ) %>%
  mutate(
    cand_ideo = case_when(
      treatment %in% c('noMOD', 'trumpMOD') ~ 'mod',
      treatment %in% c('noEX', 'trumpEX') ~ 'ex'
    ),
    endorsed = case_when(
      treatment %in% c('noMOD', 'noEX') ~ '0',
      treatment %in% c('trumpMOD', 'trumpEX') ~ '1'
    ),
    pid = factor(
      pid,
      levels = c('avg', 'rep', 'ind', 'dem'),
      labels = c(
        '1.1 Full Sample',
        '1.2 Republican Sample',
        '1.3 Independent Sample',
        '1.4 Democratic Sample'
      )
    ),
    cand_ideo = factor(
      cand_ideo,
      levels = c('mod', 'ex'),
      labels = c('Moderately\nConservative', 'Extremely\nConservative')
    )
  ) %>%
  ggplot() +
  geom_hline(yintercept = 50, color = 'grey30', linetype = "dashed") +
  geom_errorbar(
    aes(x = endorsed, y = mean, ymin = lb, ymax = ub, color = pid),
    width = 0,
    linewidth = 1,
    alpha = .4
  ) +
  geom_point(aes(x = endorsed, y = mean, color = pid), size = 2.5) +
  geom_text(
    aes(
      x = endorsed,
      y = lb,
      label = format(round(mean, 2), nsmall = 2),
      color = pid
    ),
    size = 3,
    vjust = 1.5
  ) +
  geom_text(
    data = anno.df1,
    aes(x = xstar, y = ystar, label = lab),
    size = 3,
    color = "grey30"
  ) +
  geom_segment(
    data = anno.df1,
    aes(x = x1, xend = x1, y = y1, yend = y2),
    colour = "grey30"
  ) +
  geom_segment(
    data = anno.df1,
    aes(x = x2, xend = x2, y = y1, yend = y2),
    colour = "grey30"
  ) +
  geom_segment(
    data = anno.df1,
    aes(x = x1, xend = x2, y = y2, yend = y2),
    colour = "grey30"
  ) +
  theme_bw() +
  theme(legend.position = 'none') +
  facet_nested(~ pid + cand_ideo) +
  scale_y_continuous(limits = c(0, 100)) +
  scale_color_manual(values = c('grey30', 'red', 'purple', 'blue')) +
  labs(
    x = 'Treatment: Trump Endorsement',
    y = 'Mean Thermometer Rating (0-100)',
    caption = 'Results shown by sample and assignment to candidate ideology, endorsement status.'
  ) +
  theme(
    strip.background = element_blank(),
    ggh4x.facet.nestline = element_line(colour = "black"),
    plot.caption = element_text(hjust = 0, vjust = -1)
  )


# Figure 2 ----
anno.df2 <-
  data.frame(
    x1 = rep(1, 8),
    x2 = rep(2, 8),
    y1 = c(4.05, 4.35, 3.93, 4.40, 4.13, 4.30, 4.46, 4.81), #ub on treat
    y2 = NA,
    xstar = rep(1.5, 8),
    ystar = NA,
    est = c(
      mean(ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0], na.rm = TRUE) -
        mean(ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0], na.rm = TRUE),
      mean(ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1], na.rm = TRUE) -
        mean(ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1], na.rm = TRUE),
      mean(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0 & ds$ideo < 3],
        na.rm = TRUE
      ) -
        mean(
          ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0 & ds$ideo < 3],
          na.rm = TRUE
        ),
      mean(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1 & ds$ideo < 3],
        na.rm = TRUE
      ) -
        mean(
          ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1 & ds$ideo < 3],
          na.rm = TRUE
        ),
      mean(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0 & ds$ideo == 3],
        na.rm = TRUE
      ) -
        mean(
          ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0 & ds$ideo == 3],
          na.rm = TRUE
        ),
      mean(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1 & ds$ideo == 3],
        na.rm = TRUE
      ) -
        mean(
          ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1 & ds$ideo == 3],
          na.rm = TRUE
        ),
      mean(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0 & ds$ideo > 3],
        na.rm = TRUE
      ) -
        mean(
          ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0 & ds$ideo > 3],
          na.rm = TRUE
        ),
      mean(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1 & ds$ideo > 3],
        na.rm = TRUE
      ) -
        mean(
          ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1 & ds$ideo > 3],
          na.rm = TRUE
        )
    ),
    p = c(
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0 & ds$ideo < 3],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0 & ds$ideo < 3]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1 & ds$ideo < 3],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1 & ds$ideo < 3]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0 & ds$ideo == 3],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0 & ds$ideo == 3]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1 & ds$ideo == 3],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1 & ds$ideo == 3]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0 & ds$ideo > 3],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0 & ds$ideo > 3]
      )$p.value,
      t.test(
        ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1 & ds$ideo > 3],
        ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1 & ds$ideo > 3]
      )$p.value
    ),
    cand_ideo = rep(
      c('Moderately\nConservative', 'Extremely\nConservative'),
      4
    ),
    ideo_group = c(
      '2.1 Full Sample',
      '2.1 Full Sample',
      '2.2 Conservative Sample',
      '2.2 Conservative Sample',
      '2.3 Moderate Sample',
      '2.3 Moderate Sample',
      '2.4 Liberal Sample',
      '2.4 Liberal Sample'
    )
  ) %>%
  mutate(
    y1 = y1 + .05,
    y2 = y1 + .05,
    ystar = y2 + .05,
    lab = paste0("p = ", format(round(p, 2), nsmall = 2)),
    lab = ifelse(p < 0.01, "p < 0.01", lab),
    ideo_group = factor(
      ideo_group,
      levels = c(
        '2.1 Full Sample',
        '2.2 Conservative Sample',
        '2.3 Moderate Sample',
        '2.4 Liberal Sample'
      ),
      labels = c(
        '2.1 Full Sample',
        '2.2 Conservative Sample',
        '2.3 Moderate Sample',
        '2.4 Liberal Sample'
      )
    ),
    cand_ideo = factor(
      cand_ideo,
      levels = c('Moderately\nConservative', 'Extremely\nConservative'),
      labels = c('Moderately\nConservative', 'Extremely\nConservative')
    )
  )

ds %>%
  mutate(
    ideo_group = case_when(
      ideo == 1 | ideo == 2 ~ 'lib',
      ideo == 3 ~ 'mod',
      ideo == 4 | ideo == 5 ~ 'con'
    )
  ) %>%
  filter(!is.na(cand_ideo), !is.na(treatment), !is.na(ideo_group)) %>%
  group_by(treatment, ideo_group) %>%
  summarise(
    mean = mean(cand_ideo),
    se = sd(cand_ideo) / sqrt(length(cand_ideo)),
    lb = mean - 1.96 * se,
    ub = mean + 1.96 * se
  ) %>%
  bind_rows(
    ds %>%
      filter(!is.na(cand_ideo), !is.na(treatment)) %>%
      group_by(treatment) %>%
      summarise(
        ideo_group = as.factor('avg'),
        mean = mean(cand_ideo),
        se = sd(cand_ideo) / sqrt(length(cand_ideo)),
        lb = mean - 1.96 * se,
        ub = mean + 1.96 * se
      )
  ) %>%
  mutate(
    cand_ideo = case_when(
      treatment %in% c('noMOD', 'trumpMOD') ~ 'mod',
      treatment %in% c('noEX', 'trumpEX') ~ 'ex'
    ),
    endorsed = case_when(
      treatment %in% c('noMOD', 'noEX') ~ '0',
      treatment %in% c('trumpMOD', 'trumpEX') ~ '1'
    ),
    ideo_group = factor(
      ideo_group,
      levels = c('avg', 'con', 'mod', 'lib'),
      labels = c(
        '2.1 Full Sample',
        '2.2 Conservative Sample',
        '2.3 Moderate Sample',
        '2.4 Liberal Sample'
      )
    ),
    cand_ideo = factor(
      cand_ideo,
      levels = c('mod', 'ex'),
      labels = c('Moderately\nConservative', 'Extremely\nConservative')
    )
  ) %>%
  ggplot() +
  geom_errorbar(
    aes(x = endorsed, y = mean, ymin = lb, ymax = ub, color = ideo_group),
    width = 0,
    linewidth = 1.5,
    alpha = .4
  ) +
  geom_point(aes(x = endorsed, y = mean, color = ideo_group), size = 3) +
  geom_text(
    aes(
      x = endorsed,
      y = lb,
      label = format(round(mean, 2), nsmall = 2),
      color = ideo_group
    ),
    size = 3,
    vjust = 1.5
  ) +
  geom_text(
    data = anno.df2,
    aes(x = xstar, y = ystar, label = lab),
    size = 3,
    color = "grey30"
  ) +
  geom_segment(
    data = anno.df2,
    aes(x = x1, xend = x1, y = y1, yend = y2),
    colour = "grey30"
  ) +
  geom_segment(
    data = anno.df2,
    aes(x = x2, xend = x2, y = y1, yend = y2),
    colour = "grey30"
  ) +
  geom_segment(
    data = anno.df2,
    aes(x = x1, xend = x2, y = y2, yend = y2),
    colour = "grey30"
  ) +
  theme_bw() +
  theme(legend.position = 'none') +
  facet_nested(~ ideo_group + cand_ideo) +
  scale_y_continuous(limits = c(3, 5)) +
  scale_color_manual(values = c('grey30', 'red', 'purple', 'blue')) +
  labs(
    x = 'Treatment: Trump Endorsement',
    y = 'Perceived Ideology',
    caption = 'Results shown by sample and assignment to candidate ideology, endorsement status.'
  ) +
  theme(
    strip.background = element_blank(),
    ggh4x.facet.nestline = element_line(colour = "black"),
    plot.caption = element_text(hjust = 0, vjust = -1)
  )

# Table 1 ----
## T-tests ----
ate1 <- t.test(ds$therm[ds$t_te == 1], ds$therm[ds$t_te == 0])
cate1.1 <- t.test(
  ds$therm[ds$t_te == 1 & ds$t_si == 0],
  ds$therm[ds$t_te == 0 & ds$t_si == 0]
)
cate1.2 <- t.test(
  ds$therm[ds$t_te == 1 & ds$t_si == 1],
  ds$therm[ds$t_te == 0 & ds$t_si == 1]
)
ate2 <- t.test(ds$cand_ideo[ds$t_te == 1], ds$cand_ideo[ds$t_te == 0])
cate2.1 <- t.test(
  ds$cand_ideo[ds$t_te == 1 & ds$t_si == 0],
  ds$cand_ideo[ds$t_te == 0 & ds$t_si == 0]
)
cate2.2 <- t.test(
  ds$cand_ideo[ds$t_te == 1 & ds$t_si == 1],
  ds$cand_ideo[ds$t_te == 0 & ds$t_si == 1]
)
## Results ----
data.frame(
  "Estimate" = c(
    ate1$estimate[[1]] - ate1$estimate[[2]],
    cate1.1$estimate[[1]] - cate1.1$estimate[[2]],
    cate1.2$estimate[[1]] - cate1.2$estimate[[2]],
    ate2$estimate[[1]] - ate2$estimate[[2]],
    cate2.1$estimate[[1]] - cate2.1$estimate[[2]],
    cate2.2$estimate[[1]] - cate2.2$estimate[[2]]
  ),
  "SE" = c(
    ate1$stderr,
    cate1.1$stderr,
    cate1.2$stderr,
    ate2$stderr,
    cate2.1$stderr,
    cate2.2$stderr
  ),
  "ci.lower" = c(
    ate1$conf.int[1],
    cate1.1$conf.int[1],
    cate1.2$conf.int[1],
    ate2$conf.int[1],
    cate2.1$conf.int[1],
    cate2.2$conf.int[1]
  ),
  "ci.upper" = c(
    ate1$conf.int[2],
    cate1.1$conf.int[2],
    cate1.2$conf.int[2],
    ate2$conf.int[2],
    cate2.1$conf.int[2],
    cate2.2$conf.int[2]
  ),
  "p.value" = c(
    ate1$p.value,
    cate1.1$p.value,
    cate1.2$p.value,
    ate2$p.value,
    cate2.1$p.value,
    cate2.2$p.value
  ),
  row.names = c(
    "(DV = Therm) ATE",
    "(DV = Therm) CATE, Mod. Cand.",
    "(DV = Therm) CATE, Ext. Cand.",
    "(DV = Cand. Ideo.) ATE",
    "(DV = Cand. Ideo.) CATE, Mod. Cand.",
    "(DV = Cand. Ideo.) CATE, Ext. Cand"
  )
)
# Table 2 ----
## OLS regression model (DV = Thermometer) ----
mod1 <- lm(therm ~ t_te * t_si * pid * ideo, ds)
## Results ----
summary(margins(mod1, variables = "t_te"))
summary(margins(mod1, variables = "t_te", at = list(t_si = 0:1)))
summary(margins(
  mod1,
  variables = "t_te",
  at = list(pid = c("rep", "ind", "dem"))
))
summary(margins(mod1, variables = "t_te", at = list(ideo = 1:5)))

# Table 3 ----
## OLS regression model (DV = Perceived ideology) ----
mod2 <- lm(cand_ideo ~ t_te * t_si * pid * ideo, ds)

## Results ----
summary(margins(mod2, variables = "t_te"))
summary(margins(mod2, variables = "t_te", at = list(t_si = 0:1)))
summary(margins(
  mod2,
  variables = "t_te",
  at = list(pid = c("rep", "ind", "dem"))
))
summary(margins(mod2, variables = "t_te", at = list(ideo = 1:5)))


# Table 5 ----
## Full sample model ----
med.1 <- lm(
  cand_ideo ~
    t_te +
      pid +
      ideo +
      CC22_340d +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ds %>% filter(!is.na(therm), !is.na(ideo))
)
out.1 <- lm(
  therm ~
    t_te +
      pid +
      ideo +
      CC22_340d +
      cand_ideo * ideo +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ds
)

set.seed(1234)
med.results1 <- mediate(
  med.1,
  out.1,
  treat = "t_te",
  mediator = "cand_ideo",
  sims = 1000,
  boot = TRUE,
  boot.ci.type = 'bca',
  conf.level = c(.90, .95)
)

full.med <- summary(med.results1)

## Moderate candidate sample model ----
med.2 <- lm(
  cand_ideo ~
    t_te +
      pid +
      ideo +
      CC22_340d +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ds %>%
    filter(t_si == 0) %>%
    filter(!is.na(therm), !is.na(ideo))
)
out.2 <- lm(
  therm ~
    t_te +
      pid +
      ideo +
      CC22_340d +
      cand_ideo * ideo +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ds %>% filter(t_si == 0)
)

set.seed(1234)
med.results2 <- mediate(
  med.2,
  out.2,
  treat = "t_te",
  mediator = "cand_ideo",
  sims = 1000,
  boot = TRUE,
  boot.ci.type = 'bca',
  conf.level = c(.90, .95)
)

mod.med <- summary(med.results2)

## Extreme candidate sample model ----
med.3 <- lm(
  cand_ideo ~
    t_te +
      pid +
      ideo +
      CC22_340d +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ds %>%
    filter(t_si == 1) %>%
    filter(!is.na(therm), !is.na(ideo))
)

out.3 <- lm(
  therm ~
    t_te +
      pid +
      ideo +
      CC22_340d +
      cand_ideo * ideo +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ds %>% filter(t_si == 1)
)

set.seed(1234)
med.results3 <- mediate(
  med.3,
  out.3,
  treat = "t_te",
  mediator = "cand_ideo",
  sims = 1000,
  boot = TRUE,
  boot.ci.type = 'bca',
  conf.level = c(.90, .95)
)

ext.med <- summary(med.results3)

## Results
data.frame(
  sample = c(
    rep('Full Sample', 3),
    rep('Moderate Candidate', 3),
    rep('Extreme Candidate', 3)
  ),
  qoi = c('ACME', 'NDE', 'TCE'),
  est = c(
    mean(full.med$d0.sims),
    mean(full.med$z0.sims),
    mean(full.med$tau.sims),
    mean(mod.med$d0.sims),
    mean(mod.med$z0.sims),
    mean(mod.med$tau.sims),
    mean(ext.med$d0.sims),
    mean(ext.med$z0.sims),
    mean(ext.med$tau.sims)
  ),
  lb2 = c(
    full.med$d0.ci[[2]],
    full.med$z0.ci[[2]],
    full.med$tau.ci[[2]],
    mod.med$d0.ci[[2]],
    mod.med$z0.ci[[2]],
    mod.med$tau.ci[[2]],
    ext.med$d0.ci[[2]],
    ext.med$z0.ci[[2]],
    ext.med$tau.ci[[2]]
  ),
  ub2 = c(
    full.med$d0.ci[[4]],
    full.med$z0.ci[[4]],
    full.med$tau.ci[[4]],
    mod.med$d0.ci[[4]],
    mod.med$z0.ci[[4]],
    mod.med$tau.ci[[4]],
    ext.med$d0.ci[[4]],
    ext.med$z0.ci[[4]],
    ext.med$tau.ci[[4]]
  ),
  asl = c(
    sum(full.med$d0.sims >= 0) / 1000,
    sum(full.med$z0.sims >= 0) / 1000,
    sum(full.med$tau.sims >= 0) / 1000,
    sum(mod.med$d0.sims >= 0) / 1000,
    sum(mod.med$z0.sims >= 0) / 1000,
    sum(mod.med$tau.sims >= 0) / 1000,
    sum(ext.med$d0.sims >= 0) / 1000,
    sum(ext.med$z0.sims >= 0) / 1000,
    sum(ext.med$tau.sims >= 0) / 1000
  )
)


# Figure 4 ----
data.frame(
  sample = c(
    rep('Full Sample', 3),
    rep('Moderate Candidate', 3),
    rep('Extreme Candidate', 3)
  ),
  qoi = c('ACME', 'NDE', 'TCE'),
  est = c(
    mean(full.med$d0.sims),
    mean(full.med$z0.sims),
    mean(full.med$tau.sims),
    mean(mod.med$d0.sims),
    mean(mod.med$z0.sims),
    mean(mod.med$tau.sims),
    mean(ext.med$d0.sims),
    mean(ext.med$z0.sims),
    mean(ext.med$tau.sims)
  ),
  lb = c(
    full.med$d0.ci[[1]],
    full.med$z0.ci[[1]],
    full.med$tau.ci[[1]],
    mod.med$d0.ci[[1]],
    mod.med$z0.ci[[1]],
    mod.med$tau.ci[[1]],
    ext.med$d0.ci[[1]],
    ext.med$z0.ci[[1]],
    ext.med$tau.ci[[1]]
  ),
  lb2 = c(
    full.med$d0.ci[[2]],
    full.med$z0.ci[[2]],
    full.med$tau.ci[[2]],
    mod.med$d0.ci[[2]],
    mod.med$z0.ci[[2]],
    mod.med$tau.ci[[2]],
    ext.med$d0.ci[[2]],
    ext.med$z0.ci[[2]],
    ext.med$tau.ci[[2]]
  ),
  ub = c(
    full.med$d0.ci[[3]],
    full.med$z0.ci[[3]],
    full.med$tau.ci[[3]],
    mod.med$d0.ci[[3]],
    mod.med$z0.ci[[3]],
    mod.med$tau.ci[[3]],
    ext.med$d0.ci[[3]],
    ext.med$z0.ci[[3]],
    ext.med$tau.ci[[3]]
  ),
  ub2 = c(
    full.med$d0.ci[[4]],
    full.med$z0.ci[[4]],
    full.med$tau.ci[[4]],
    mod.med$d0.ci[[4]],
    mod.med$z0.ci[[4]],
    mod.med$tau.ci[[4]],
    ext.med$d0.ci[[4]],
    ext.med$z0.ci[[4]],
    ext.med$tau.ci[[4]]
  ),
  asl = c(
    sum(full.med$d0.sims >= 0) / 1000,
    sum(full.med$z0.sims >= 0) / 1000,
    sum(full.med$tau.sims >= 0) / 1000,
    sum(mod.med$d0.sims >= 0) / 1000,
    sum(mod.med$z0.sims >= 0) / 1000,
    sum(mod.med$tau.sims >= 0) / 1000,
    sum(ext.med$d0.sims >= 0) / 1000,
    sum(ext.med$z0.sims >= 0) / 1000,
    sum(ext.med$tau.sims >= 0) / 1000
  )
) %>%
  mutate(
    qoi = factor(
      qoi,
      levels = c(
        'ACME',
        'NDE',
        'TCE'
      )
    ),
    sample = factor(
      sample,
      levels = c(
        'Full Sample',
        'Moderate Candidate',
        'Extreme Candidate'
      )
    ),
    estF = sprintf(
      "%s%s",
      format(round(est, 2), nsmall = 2),
      case_when(
        asl < 0.001 ~ "***",
        asl < 0.01 ~ "**",
        asl < 0.05 ~ "*",
        asl >= 0.05 ~ ""
      )
    )
  ) %>%
  ggplot(
    aes(
      x = est,
      y = fct_rev(qoi),
      group = fct_rev(sample),
      color = fct_rev(sample)
    )
  ) +
  geom_vline(
    aes(
      xintercept = 0
    )
  ) +
  geom_errorbar(
    aes(
      xmin = lb2,
      xmax = ub2
    ),
    width = 0,
    position = position_dodge(width = 0.5)
  ) +
  geom_errorbar(
    aes(
      xmin = lb,
      xmax = ub
    ),
    width = 0,
    linewidth = 1,
    position = position_dodge(width = 0.5)
  ) +
  geom_point(
    aes(
      shape = fct_rev(sample)
    ),
    size = 2.5,
    position = position_dodge(width = 0.5)
  ) +
  geom_text(
    aes(
      label = estF
    ),
    position = position_dodge(width = 0.5),
    vjust = -.5,
    show.legend = FALSE
  ) +
  labs(
    x = '',
    y = ''
  ) +
  theme_bw() +
  scale_x_continuous(
    limits = c(-14, 2),
    breaks = seq(-14, 2, 2)
  ) +
  scale_color_viridis_d(
    option = 'viridis',
    end = .6,
    direction = -1
  ) +
  theme(
    legend.position = c(.2, .85),
    legend.title = element_blank(),
    legend.background = element_rect(
      color = 'grey30'
    )
  ) +
  guides(
    color = guide_legend(reverse = TRUE),
    shape = guide_legend(reverse = TRUE)
  )

# Figure 5 ----
## Figure 5.1 ----
ces %>%
  mutate(
    lic = case_when(
      low_info_cand == 1 ~ 'Low Information',
      low_info_cand == 0 ~ 'Not Low Information'
    ),
    te = as.factor(te)
  ) %>%
  filter(!is.na(lic), !is.na(ideo_r)) %>%
  group_by(lic, te, stcd_code) %>%
  summarise(
    mean = mean(ideo_r, na.rm = TRUE),
    sd = sd(ideo_r, na.rm = TRUE),
    n = length(ideo_r),
    se = sd / sqrt(n)
  ) %>%
  ggplot(
    aes(
      x = te,
      y = mean
    )
  ) +
  geom_jitter(
    alpha = .20,
    height = 0,
    width = .25,
    size = .8
  ) +
  geom_boxplot(
    alpha = 0,
    width = .25,
    linewidth = .7
  ) +
  facet_wrap(~lic) +
  theme_bw() +
  labs(
    x = 'Trump Endorsement',
    y = 'Mean Perceived Ideology',
    title = '5.1 Mean and Variance of Perceived Ideology by Trump Endorsement Status, Information Context'
  ) +
  scale_y_continuous(
    limits = c(3, 7),
    breaks = seq(1, 7, 1)
  ) +
  theme(
    strip.background = element_blank(),
    plot.title.position = 'plot',
    plot.margin = unit(c(1, .5, .5, 1), "cm")
  )

## Figure 5.2 ----
omod <- lm(
  voted_rep ~
    te *
      pid *
      ideo_s *
      low_info_cand +
      te * id_dist * low_info_cand +
      te * diff * low_info_cand +
      male +
      educ +
      age +
      white +
      hispanic +
      trump16 +
      trump20,
  ces %>%
    filter(
      vv == 1,
      CC22_340d <= 7
    ) %>%
    mutate(diff = CC22_340d - ideo_s)
)

ome.pid <- data.frame(summary(margins(
  omod,
  at = list(low_info_cand = 0:1, pid = c('rep', 'ind', 'dem')),
  variables = "te"
)))
ome.pid$lic <- c(rep('Not Low Information', 3), rep('Low Information', 3))
ome.pid$pid_alt <- rep(c('Republican', 'Independent', "Democrat"), 2)
ome.pid$anno <- ifelse(
  ome.pid$p < 0.05,
  paste0(format(round(ome.pid$AME, 2), nsmall = 2), "*"),
  paste0(format(round(ome.pid$AME, 2), nsmall = 2))
)

ome.pid %>%
  ggplot(
    aes(
      x = pid_alt,
      y = AME
    )
  ) +
  geom_hline(
    aes(
      yintercept = 0
    ),
    linetype = "dashed"
  ) +
  geom_errorbar(
    aes(
      ymin = lower,
      ymax = upper
    ),
    width = 0
  ) +
  geom_point() +
  geom_text(aes(y = AME - 1.96 * SE, label = anno), vjust = 1.5) +
  facet_wrap(~lic) +
  theme_bw() +
  labs(
    x = 'Respondent Party',
    y = 'Marginal Effect',
    title = '5.2 Marginal Effect of Trump Endorsement on Vote Choice by Party, Information Context'
  ) +
  scale_y_continuous(
    limits = c(-0.125, 0.125),
    breaks = seq(-0.1, 0.1, 0.05)
  ) +
  theme(
    strip.background = element_blank(),
    plot.title.position = 'plot',
    plot.margin = unit(c(1, .5, .5, 1), "cm")
  )

## Figure 5.3 ----
ome.ideo <- data.frame(summary(margins(
  omod,
  at = list(low_info_cand = 0:1, diff = -6:6),
  variables = "te"
)))
ome.ideo$lic <- c(rep('Not Low Information', 13), rep('Low Information', 13))
ome.ideo$pid_alt <- rep(c(-6:6), 2)
ome.ideo$anno <- ifelse(
  ome.ideo$p < 0.05,
  paste0(format(round(ome.ideo$AME, 2), nsmall = 2), "*"),
  paste0(format(round(ome.ideo$AME, 2), nsmall = 2))
)

ome.ideo %>%
  mutate(
    pid_alt = factor(
      pid_alt
    )
  ) %>%
  ggplot(
    aes(
      x = pid_alt,
      y = AME
    )
  ) +
  geom_hline(
    aes(
      yintercept = 0
    ),
    linetype = "dashed"
  ) +
  geom_line(aes(group = lic)) +
  geom_line(aes(y = lower, group = lic), linetype = 'dotted') +
  geom_line(aes(y = upper, group = lic), linetype = 'dotted') +
  geom_ribbon(
    aes(ymin = lower, ymax = upper, group = lic),
    fill = "black",
    alpha = .1
  ) +
  facet_wrap(~lic) +
  theme_bw() +
  labs(
    x = 'Ideological Proximity to Donald Trump',
    y = 'Marginal Effect',
    title = '5.3 Marginal Effect of Trump Endorsement on Vote Choice by Ideological Position, Information Context'
  ) +
  scale_x_discrete(
    labels = c(
      "-6",
      "-5",
      "-4\nMore conservative\nthan Trump",
      "-3",
      "-2",
      "-1",
      "0\nThe same\nas Trump",
      "1",
      "2",
      "3",
      "4\nMore liberal\nthan Trump",
      "5",
      "6"
    )
  ) +
  scale_y_continuous(
    limits = c(-0.125, 0.125),
    breaks = seq(-0.10, 0.10, 0.05)
  ) +
  theme(
    strip.background = element_blank(),
    plot.title.position = 'plot',
    plot.margin = unit(c(1, .5, .5, 1), "cm")
  )


## Figure 5.4 ----
med.fit <-
  lm(
    ideo_r ~
      te *
        ideo_s +
        te * diff +
        male +
        educ +
        age +
        white +
        hispanic +
        trump16 +
        trump20,
    ces %>%
      filter(
        low_info_cand == 1,
        vv == 1,
        pid == "ind"
      ) %>%
      mutate(diff = ideo_trump - ideo_s) %>%
      filter(!is.na(voted_rep))
  )

out.fit <-
  lm(
    voted_rep ~
      ideo_r +
        te * ideo_s +
        te * diff +
        male +
        educ +
        age +
        white +
        hispanic +
        trump16 +
        trump20,
    ces %>%
      filter(
        low_info_cand == 1,
        vv == 1,
        pid == "ind"
      ) %>%
      mutate(diff = ideo_trump - ideo_s)
  )
set.seed(1234)
med.out <-
  mediate(
    med.fit,
    out.fit,
    treat = "te",
    mediator = "ideo_r",
    sims = 1000,
    boot = TRUE,
    boot.ci.type = 'bca',
    conf.level = c(.90, .95)
  )

data.frame(
  qoi = c('ACME', 'NDE', 'TCE'),
  est = c(
    mean(med.out$d0.sims),
    mean(med.out$z0.sims),
    mean(med.out$tau.sims)
  ),
  lb = c(
    med.out$d0.ci[[1]],
    med.out$z0.ci[[1]],
    med.out$tau.ci[[1]]
  ),
  lb2 = c(
    med.out$d0.ci[[2]],
    med.out$z0.ci[[2]],
    med.out$tau.ci[[2]]
  ),
  ub = c(
    med.out$d0.ci[[3]],
    med.out$z0.ci[[3]],
    med.out$tau.ci[[3]]
  ),
  ub2 = c(
    med.out$d0.ci[[4]],
    med.out$z0.ci[[4]],
    med.out$tau.ci[[4]]
  ),
  asl = c(
    sum(med.out$d0.sims >= 0) / 1000,
    sum(med.out$z0.sims >= 0) / 1000,
    sum(med.out$tau.sims >= 0) / 1000
  )
) %>%
  mutate(
    qoi = factor(
      qoi,
      levels = c(
        'ACME',
        'NDE',
        'TCE'
      )
    ),
    estF = paste0(
      format(round(est, 2), nsmall = 2),
      case_when(
        asl < 0.05 ~ "*",
        asl >= 0.05 ~ ""
      )
    )
  ) %>%
  ggplot(
    aes(
      x = est,
      y = fct_rev(qoi)
    )
  ) +
  geom_vline(
    aes(
      xintercept = 0
    )
  ) +
  geom_errorbar(
    aes(
      xmin = lb2,
      xmax = ub2
    ),
    width = 0,
    position = position_dodge(width = 0.5)
  ) +
  geom_errorbar(
    aes(
      xmin = lb,
      xmax = ub
    ),
    width = 0,
    linewidth = 1,
    position = position_dodge(width = 0.5)
  ) +
  geom_point(
    size = 2.5,
    position = position_dodge(width = 0.5)
  ) +
  geom_text(
    aes(
      label = estF
    ),
    position = position_dodge(width = 0.5),
    vjust = -.5,
    show.legend = FALSE
  ) +
  labs(
    x = '',
    y = '',
    title = '5.4 Mediated Effect of Trump Endorsement on Vote Choice by Perceived Ideology',
    subtitle = 'among Independents in Low Information Contexts',
    caption = "* denotes ASL<0.05"
  ) +
  theme_bw() +
  scale_x_continuous(
    limits = c(-.10, 0.02),
    breaks = seq(-.10, .02, .02)
  ) +
  theme(
    legend.position = c(.2, .85),
    legend.title = element_blank(),
    legend.background = element_rect(
      color = 'grey30'
    ),
    plot.title.position = 'plot',
    plot.subtitle = element_text(face = "italic"),
    plot.margin = unit(c(1, .5, .5, 1), "cm")
  )
